home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / Test / Harness / Results.pm < prev    next >
Encoding:
Perl POD Document  |  2009-06-26  |  4.0 KB  |  183 lines
  1. # -*- Mode: cperl; cperl-indent-level: 4 -*-
  2. package Test::Harness::Results;
  3.  
  4. use strict;
  5. use vars qw($VERSION);
  6. $VERSION = '0.01';
  7.  
  8. =head1 NAME
  9.  
  10. Test::Harness::Results - object for tracking results from a single test file
  11.  
  12. =head1 SYNOPSIS
  13.  
  14. One Test::Harness::Results object represents the results from one
  15. test file getting analyzed.
  16.  
  17. =head1 CONSTRUCTION
  18.  
  19. =head2 new()
  20.  
  21.     my $results = new Test::Harness::Results;
  22.  
  23. Create a test point object.  Typically, however, you'll not create
  24. one yourself, but access a Results object returned to you by
  25. Test::Harness::Results.
  26.  
  27. =cut
  28.  
  29. sub new {
  30.     my $class = shift;
  31.     my $self  = bless {}, $class;
  32.  
  33.     return $self;
  34. }
  35.  
  36. =head1 ACCESSORS
  37.  
  38. The following data points are defined:
  39.  
  40.   passing           true if the whole test is considered a pass 
  41.                     (or skipped), false if its a failure
  42.  
  43.   exit              the exit code of the test run, if from a file
  44.   wait              the wait code of the test run, if from a file
  45.  
  46.   max               total tests which should have been run
  47.   seen              total tests actually seen
  48.   skip_all          if the whole test was skipped, this will 
  49.                       contain the reason.
  50.  
  51.   ok                number of tests which passed 
  52.                       (including todo and skips)
  53.  
  54.   todo              number of todo tests seen
  55.   bonus             number of todo tests which 
  56.                       unexpectedly passed
  57.  
  58.   skip              number of tests skipped
  59.  
  60. So a successful test should have max == seen == ok.
  61.  
  62.  
  63. There is one final item, the details.
  64.  
  65.   details           an array ref reporting the result of 
  66.                     each test looks like this:
  67.  
  68.     $results{details}[$test_num - 1] = 
  69.             { ok          => is the test considered ok?
  70.               actual_ok   => did it literally say 'ok'?
  71.               name        => name of the test (if any)
  72.               diagnostics => test diagnostics (if any)
  73.               type        => 'skip' or 'todo' (if any)
  74.               reason      => reason for the above (if any)
  75.             };
  76.  
  77. Element 0 of the details is test #1.  I tried it with element 1 being
  78. #1 and 0 being empty, this is less awkward.
  79.  
  80.  
  81. Each of the following fields has a getter and setter method.
  82.  
  83. =over 4
  84.  
  85. =item * wait
  86.  
  87. =item * exit
  88.  
  89. =cut
  90.  
  91. sub set_wait { my $self = shift; $self->{wait} = shift }
  92. sub wait {
  93.     my $self = shift;
  94.     return $self->{wait} || 0;
  95. }
  96.  
  97. sub set_skip_all { my $self = shift; $self->{skip_all} = shift }
  98. sub skip_all {
  99.     my $self = shift;
  100.     return $self->{skip_all};
  101. }
  102.  
  103. sub inc_max { my $self = shift; $self->{max} += (@_ ? shift : 1) }
  104. sub max {
  105.     my $self = shift;
  106.     return $self->{max} || 0;
  107. }
  108.  
  109. sub set_passing { my $self = shift; $self->{passing} = shift }
  110. sub passing {
  111.     my $self = shift;
  112.     return $self->{passing} || 0;
  113. }
  114.  
  115. sub inc_ok { my $self = shift; $self->{ok} += (@_ ? shift : 1) }
  116. sub ok {
  117.     my $self = shift;
  118.     return $self->{ok} || 0;
  119. }
  120.  
  121. sub set_exit { 
  122.     my $self = shift; 
  123.     if ($^O eq 'VMS') {
  124.         eval {
  125.             use vmsish q(status);
  126.             $self->{exit} = shift;  # must be in same scope as pragma
  127.         }
  128.     }
  129.     else {
  130.         $self->{exit} = shift;
  131.     }
  132. }
  133. sub exit {
  134.     my $self = shift;
  135.     return $self->{exit} || 0;
  136. }
  137.  
  138. sub inc_bonus { my $self = shift; $self->{bonus}++ }
  139. sub bonus {
  140.     my $self = shift;
  141.     return $self->{bonus} || 0;
  142. }
  143.  
  144. sub set_skip_reason { my $self = shift; $self->{skip_reason} = shift }
  145. sub skip_reason {
  146.     my $self = shift;
  147.     return $self->{skip_reason} || 0;
  148. }
  149.  
  150. sub inc_skip { my $self = shift; $self->{skip}++ }
  151. sub skip {
  152.     my $self = shift;
  153.     return $self->{skip} || 0;
  154. }
  155.  
  156. sub inc_todo { my $self = shift; $self->{todo}++ }
  157. sub todo {
  158.     my $self = shift;
  159.     return $self->{todo} || 0;
  160. }
  161.  
  162. sub inc_seen { my $self = shift; $self->{seen}++ }
  163. sub seen {
  164.     my $self = shift;
  165.     return $self->{seen} || 0;
  166. }
  167.  
  168. sub set_details {
  169.     my $self = shift;
  170.     my $index = shift;
  171.     my $details = shift;
  172.  
  173.     my $array = ($self->{details} ||= []);
  174.     $array->[$index-1] = $details;
  175. }
  176.  
  177. sub details {
  178.     my $self = shift;
  179.     return $self->{details} || [];
  180. }
  181.  
  182. 1;
  183.